Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH8/SRC/FLAKE2.FRM

Visual Basic Form | 1996-05-02 | 6.0 KB | 216 lines

VERSION 4.00
Begin VB.Form FlakeForm
   Caption         =   "Snowflake"
   ClientHeight    =   4335
   ClientLeft      =   2280
   ClientTop       =   1185
   ClientWidth     =   5355
   Height          =   5025
   Left            =   2220
   LinkTopic       =   "Form1"
   ScaleHeight     =   289
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   357
   Top             =   555
   Width           =   5475
   Begin VB.TextBox LevelText
      Height          =   285
      Left            =   600
      MaxLength       =   3
      TabIndex        =   0
      Text            =   "4"
      Top             =   0
      Width           =   375
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4335
      Left            =   1080
      ScaleHeight     =   285
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   281
      TabIndex        =   3
      Top             =   0
      Width           =   4275
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   735
   End
   Begin MSComDlg.CommonDialog FileDialog
      Left            =   240
      Top             =   1440
      _version        =   65536
      _extentx        =   847
      _extenty        =   847
      _stockprops     =   0
      cancelerror     =   -1  'True
   End
   Begin VB.Label Label1
      Caption         =   "Level"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   495
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileLoad
         Caption         =   "&Load..."
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuFileSep
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "FlakeForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const PI = 3.14159
Dim TheLevel As Integer
Dim StartLength As Integer
' Coordinates of the points in the initiator.
Dim NumIni As Integer
Dim IniX() As Single
Dim IniY() As Single
' Angles and distances for the generator.
Dim NumGen As Integer
Dim DistFactor As Single
Dim GenDTheta() As Single
Sub GetParameters()
    If Not IsNumeric(LevelText.Text) Then _
        LevelText.Text = "4"
    TheLevel = CInt(LevelText.Text)
End Sub
' ************************************************
' Load a snowflake definition file with format:
'   # Initiator points.
'   (x1, y1)
'   (x2, y2)
'       :
'   DistFactor
'   # Generator angles.
'   theta1
'   theta2
'       :
' ************************************************
Private Sub mnuFileLoad_Click()
Dim fname As String
Dim fnum As Integer
Dim theta As Single
Dim i As Integer
    ' Allow the user to pick a file.
    On Error Resume Next
    FileDialog.FilterIndex = 1
    FileDialog.filename = "*.SNO"
    FileDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
    FileDialog.ShowOpen
    If Err.Number = cdlCancel Then
        Exit Sub
    ElseIf Err.Number <> 0 Then
        Beep
        MsgBox "Error selecting file.", , vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    fname = Trim$(FileDialog.filename)
    FileDialog.InitDir = Left$(fname, Len(fname) _
        - Len(FileDialog.FileTitle) - 1)
    ' Open the file.
    fnum = FreeFile
    Open fname For Input Access Read As #fnum
    ' Read the initiator.
    Input #fnum, NumIni
    ReDim IniX(0 To NumIni)
    ReDim IniY(0 To NumIni)
    For i = 1 To NumIni
        Input #fnum, IniX(i), IniY(i)
    Next i
    IniX(0) = IniX(NumIni)
    IniY(0) = IniY(NumIni)
    ' Read the generator information.
    Input #fnum, DistFactor, NumGen
    ReDim GenDTheta(1 To NumGen)
    For i = 1 To NumGen
        Input #fnum, theta
        GenDTheta(i) = theta * PI / 180
    Next i
    Close #fnum
    Caption = "Snowflake [" & fname & "]"
    CmdGo.Enabled = True
End Sub
' ************************************************
' Recursively draw a snowflake edge starting at
' (x1, y1) in direction theta and distance dist.
' Leave the coordinates of the endpoint in
' (x1, y1).
' ************************************************
Sub DrawFlakeEdge(level As Integer, x1 As Single, y1 As Single, ByVal theta As Single, ByVal dist As Single)
Dim status As Integer
Dim i As Integer
Dim x2 As Single
Dim y2 As Single
    If level <= 0 Then
        x2 = x1 + dist * Cos(theta)
        y2 = y1 + dist * Sin(theta)
        Canvas.Line (x1, y1)-(x2, y2)
        x1 = x2
        y1 = y2
        Exit Sub
    End If
    ' Recursively draw the edge.
    dist = dist * DistFactor
    For i = 1 To NumGen
        theta = theta + GenDTheta(i)
        DrawFlakeEdge level - 1, x1, y1, theta, dist
    Next i
End Sub
Private Sub CmdGo_Click()
Dim i As Integer
Dim x1 As Single
Dim y1 As Single
Dim x2 As Single
Dim y2 As Single
Dim dx As Single
Dim dy As Single
Dim theta As Single
    MousePointer = vbHourglass
    DoEvents
    Canvas.Cls
    ' Get the parameters.
    GetParameters
    ' Draw the snowflake.
    For i = 1 To NumIni
        x1 = IniX(i - 1)
        y1 = IniY(i - 1)
        x2 = IniX(i)
        y2 = IniY(i)
        dx = x2 - x1
        dy = y2 - y1
        theta = Arctan2(dx, dy)
        StartLength = Sqr(dx * dx + dy * dy)
        DrawFlakeEdge TheLevel, x1, y1, _
            theta, StartLength
    Next i
    MousePointer = vbDefault
End Sub
Private Sub Form_Resize()
    Canvas.Move Canvas.Left, 0, _
        ScaleWidth - Canvas.Left, ScaleHeight - 1
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub